Clipper Collection/Clipper Collection.iso/clipper7/clipwind.arc/WDEMO.PRG

Text File | 1988-03-24 | 35KB | 1,056 lines

******************************************************************************
* Program:  WDEMO.PRG                                                         *
* Author:   Jim Holley                                                        *
*           1346 Woodington Cir.                                              *
*           Lawrenceville, Ga. 30245     Ph. # 404-564-3647                   *
* Date:     Start 12/30/87 - Continuing                                       *
* Notice: Copyright (C) 1986, 1987, 1988 Jim Holley, All Rights Reserved.     *
* Version: 2.0                                                                *
* Notes:                          Window Demo.                                *
*                                                                             *
*   This is the original Demo program distributed with Windows For Clipper.   *
* It is included for informational purposes only.                             *
*                                                                             *
* This is a demo of the Windows For Clipper routines. It demonstrates most of *
* the functions that are available to the clipper programmer. All functions   *
* are in the library CLIPWIND.LIB.                                            *
*                                                                             *
* For more information on Windows For Clipper, contact Jim Holley at the      *
* above address or by calling                                                 *
* 404-564-3647 after  6 on weekdays, anytime on weekends.                     *
* To purchase directly send check or money order to the above address.        *
* For check purchases, please allow 3 to 4 weeks for delivery.                *
* The price for Windows for Clipper library is $44.95.                        *
* Georgia residence add appriate sales tax. Please see the REGISTER.DOC file  *
* included.                                                                   *
*                                                                             *
* At this point in time I am unable to accept credit card purchases. This     *
* may be remedied in the future.                                              *
*******************************************************************************

***********************
* turn the cursor off *
***********************
SET CURSOR OFF

******************
* set enviroment *
******************
SET SCOREBOARD OFF

*******************************
* initialize needed variables *
*******************************
single = 218
double = 201
messrow = 23
scroll = 0
Store 0 to wn1, wn2, wn3, wn4, wn5, wn6


************************************
* create opening windows and check *
* to make sure windows are created *
************************************
wn1 = _sinit_wn(23,6,28,9)
IF wn1 = 0
   @ messrow,0 SAY "Unable to create window wn1"
   WAIT
   RETURN
ENDIF
wn2 = _sinit_wn(24,7,28,9)
IF wn2 = 0
   @ messrow,0 SAY "Unable to create window wn2"
   WAIT
   RETURN
ENDIF
wn3 = _sinit_wn(25,8,28,9)
IF wn3 = 0
   @ messrow,0 SAY "Unable to create window wn3"
   WAIT
   RETURN
ENDIF
wn4 = _sinit_wn(26,9,28,9)
IF wn4 = 0
   @ messrow,0 SAY "Unable to create window wn4"
   WAIT
   RETURN
ENDIF
wn5 = _sinit_wn(27,10,28,9)
IF wn5 = 0
   @ messrow,0 SAY "Unable to create window wn5"
   WAIT
   RETURN
ENDIF
wn6 = _sinit_wn(0,0,8,2)
IF wn6 = 0
   @ messrow,0 SAY "Unable to create window wn6"
   WAIT
   RETURN
ENDIF

*******************************
* set window border character *
*******************************
IF .NOT. _sst_wnbc(wn1, double)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
ENDIF
IF .NOT. _sst_wnbc(wn2, double)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
ENDIF
IF .NOT. _sst_wnbc(wn3, double)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
ENDIF
IF .NOT. _sst_wnbc(wn4, double)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
ENDIF
IF .NOT. _sst_wnbc(wn5, double)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
ENDIF

*******************************
* set window color (contents) *
*******************************
IF .NOT. _sst_wncl(wn1, "b/o/h/", "C")
   @ messrow, 0 SAY "Unable to set color for contents in wn1"
ENDIF
IF .NOT. _sst_wncl(wn2, "b/m/h/", "C")
   @ messrow, 0 SAY "Unable to set color for contents in wn2"
ENDIF
IF .NOT. _sst_wncl(wn3, "b/c/h/", "C")
   @ messrow, 0 SAY "Unable to set color for contents in wn3"
ENDIF
IF .NOT. _sst_wncl(wn4, "b/g/h/", "C")
   @ messrow, 0 SAY "Unable to set color for contents in wn4"
ENDIF
IF .NOT. _sst_wncl(wn5, "b/w//", "C")
   @ messrow, 0 SAY "Unable to set color for contents in wn5"
ENDIF

*****************************
* set window color (border) *
*****************************
IF .NOT. _sst_wncl(wn1, "b/w//", "B")
   @ messrow, 0 SAY "Unable to set color for border in wn1"
ENDIF
IF .NOT. _sst_wncl(wn2, "b/w//", "B")
   @ messrow, 0 SAY "Unable to set color for border in wn2"
ENDIF
IF .NOT. _sst_wncl(wn3, "b/w//", "B")
   @ messrow, 0 SAY "Unable to set color for border in wn3"
ENDIF
IF .NOT. _sst_wncl(wn4, "b/w//", "B")
   @ messrow, 0 SAY "Unable to set color for border in wn4"
ENDIF
IF .NOT. _sst_wncl(wn5, "b/w//", "B")
   @ messrow, 0 SAY "Unable to set color for border in wn5"
ENDIF

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn1)

*********************
* write text to wn1 *
*********************
_swte_txt(wn1, " ")
_swte_txt(wn1, "   They're easy to use  ")
_swte_txt(wn1, " ")
_swte_txt(wn1, "     Not confusing.")

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn2)

*********************
* write text to wn2 *
*********************
_swte_txt(wn2, " ")
_swte_txt(wn2, "   They're Very fast    ")
_swte_txt(wn2, " ")
_swte_txt(wn2, "      Not Clunkers.")

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn3)

*********************
* write text to wn3 *
*********************
_swte_txt(wn3, " ")
_swte_txt(wn3, "   They need very little")
_swte_txt(wn3, "   ram to operate.")
_swte_txt(wn3, "  ")

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn4)

*********************
* write text to wn4 *
*********************
_swte_txt(wn4, " ")
_swte_txt(wn4, " Designed specifically")
_swte_txt(wn4, "        for the" )
_swte_txt(wn4, "   Clipper Compiler")

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn5)

*********************
* write text to wn5 *
*********************
_swte_txt(wn5, "    WINDOWS FOR CLIPPER")
_swte_txt(wn5, "        Version 1.0")
_swte_txt(wn5, "       By Jim Holley")
_swte_txt(wn5, "   1346 Woodington Cir.")
_swte_txt(wn5, "  Lawrenceville Ga, 30245")
_swte_txt(wn5, " ")
_swte_txt(wn5, " Clipper is a trademark of")
_swte_txt(wn5, "    Nantucket Corp.")

*******************************
* set window border character *
*******************************
if .not. _sst_wnbc(wn6, single)
   @ messrow,0 SAY "Unable to set border character. Default of Space used."
endif

*******************************
* set window color (contents) *
*******************************
_sst_wncl(wn6, "b/w//", "C")

*********************************
* draw the window on the screen *
*********************************
_sdrw_wn(wn6)

*********************
* write text to wn6 *
*********************
_swte_txt(wn6, "Clipper")
_swte_txt(wn6, " Windows")

@ messrow,0
@ messrow,0 SAY "Press Any Key To Continue."

******************************************************
* set up loop to make windows move around the screen *
******************************************************
loopsw = .T.
DO WHILE loopsw
   wnrow = 0
   **************************************************
   * this loop moves window right across the screen *
   **************************************************
   FOR wncol = 10 TO 60 STEP 10
      delay = 0
      **********************************************
      * move the window to new column, row coords. *
      **********************************************
      _smove_wn(wn6, wncol, wnrow)
      key = INKEY()
      IF key <> 0
         loopsw = .F.
         EXIT
      ENDIF
      DO WHILE delay <= 500
         delay = delay + 1
      ENDDO
   NEXT
   IF .NOT. loopsw
      LOOP
   ENDIF
   *****************************************************
   *  this loop moves window down right side of screen *
   *****************************************************
   FOR wnrow = 0 TO 20 STEP 5
      delay = 0
      **********************************************
      * move the window to new column, row coords. *
      **********************************************
      _smove_wn(wn6, wncol, wnrow)
      key = INKEY()
      IF key <> 0
         loopsw = .F.
         EXIT
      ENDIF
      DO WHILE delay <= 500
         delay = delay + 1
      ENDDO
   NEXT
   IF .NOT. loopsw
      LOOP
   ENDIF
   wnrow = 20
   *************************************************
   * this loop moves window left across the screen *
   *************************************************
   FOR wncol = 60 TO 10 STEP -10
      delay = 0
      _smove_wn(wn6, wncol, wnrow)
      key = INKEY()
      IF key <> 0
         loopsw = .F.
         EXIT
      ENDIF
      **********************************************
      * move the window to new column, row coords. *
      **********************************************
      DO WHILE delay <= 500
         delay = delay + 1
      ENDDO
   NEXT
   IF .NOT. loopsw
      LOOP
   ENDIF
   *************************************************
   * this loop moves window up left side of screen *
   *************************************************
   wncol = 0
   FOR wnrow = 20 TO 0 STEP -5
      delay = 0
      **********************************************
      * move the window to new column, row coords. *
      **********************************************
      _smove_wn(wn6, wncol, wnrow)
      key = INKEY()
      IF key <> 0
         loopsw = .F.
         EXIT
      ENDIF
      DO WHILE delay <= 500
         delay = delay + 1
      ENDDO
   NEXT
ENDDO

************
* home wn6 *
************
_smove_wn(wn6,0,0)

*************************
* erase wn6 from screen *
* it will be used again *
*************************
_swnerase(wn6)

@ messrow,0
@ messrow,20 SAY "Press Any Key To Continue."

********************************
* remove windows one at a time *
********************************
INKEY(0)
_srem_wn(wn5)
INKEY(0)
_srem_wn(wn4)
INKEY(0)
_srem_wn(wn3)
INKEY(0)
_srem_wn(wn2)
INKEY(0)
_srem_wn(wn1)

***************************************************************
* change the deminsions of wn6 to have 40 columns and 23 rows *
***************************************************************
_swnchg(wn6,40,23)

********************
* set window color *
********************
_sst_wncl(wn6, "b/m//","C")
_sst_wncl(wn6, "b/m//","B")

***************************************************
* draw wn6 back to the screen with new deminsions *
***************************************************
_sdrw_wn(wn6)

*********************
* write text to wn6 *
*********************
_swte_txt(wn6, " This is a demonstration of Windows")
_swte_txt(wn6, " For Clipper. A library of window")
_swte_txt(wn6, " routines for the Clipper Programmer.")
_swte_txt(wn6, " The library contains all the basic ")
_swte_txt(wn6, " functions to allow window creation")
_swte_txt(wn6, " and manipulation. The library was ")
_swte_txt(wn6, " written in 'C' and assembler to give")
_swte_txt(wn6, " peak performance and small code size.")
_swte_txt(wn6, " At link time, only the functions your")
_swte_txt(wn6, " program requires are linked, unlike")
_swte_txt(wn6, " the extend UDF's that come with the")
_swte_txt(wn6, " Clipper package, where all functions")
_swte_txt(wn6, " are linked whether you need them or")
_swte_txt(wn6, " not. The library consists of ")
_swte_txt(wn6, " 1. Window initialization and control")
_swte_txt(wn6, "    functions.")
_swte_txt(wn6, " 2. Window output functions.")
_swte_txt(wn6, " 3. Window input functions.")
_swte_txt(wn6, " There is also special functions for ")
_swte_txt(wn6, " use with databases.")
_swte_txt(wn6, " ")
_swte_txt(wn6, " ")
_swte_txt(wn6, "       Press Any Key To Continue ")
INKEY(0)
****************************
* remove wn6 from memory   *
* we are going to redefine *
* it with a different      *
* location and size        *
****************************
_srem_wn(wn6)

*************************************
* set to 0 so that it can be tested *
*************************************
wn6 = 0

************************
* get wn6 window again *
************************
wn6 = _sinit_wn(16,0,47,6)

************************************************
* test to make sure the window was initialized *
************************************************
IF wn6 = 0
   @ messrow,0 SAY "Unable to create window wn6"
   WAIT
ELSE
   *******************************
   * set window border character *
   *******************************
   IF .NOT. _sst_wnbc(wn6, single)
      @ messrow,0 SAY "Unable to set border character. Default of Space used."
   ENDIF

   ********************
   * set window color *
   ********************
   _sst_wncl(wn6, "b/w/h/","C")
   _sst_wncl(wn6, "b/w/h/","B")

ENDIF


DO WHILE .T.
   SET DELIMITERS TO DEFAULT

   ******************
   * Turn cursor on *
   ******************
   SET CURSOR ON

   ************************************************
   * this first section just asks for preliminary *
   * information to establish the window          *
   ************************************************

   STORE 0 TO trow, tcol, numcol, numrow
   STORE SPACE(78) TO text1, text2, text3, text4, text5, text6
   bchar = " "
   bcolor = "       "
   ccolor = "       "
   IF wn6 <> 0
      ***********************************************************
      * This next section demonstates that Clipper can be used  *
      * to write to, and read from a window. The difference is, *
      * you have to calculate the start and stop coordinates,   *
      * and you have to maintain the color selection using the  *
      * SET COLOR command.                                      *
      ***********************************************************
      CLEAR
      _sdrw_wn(wn6)
      SET COLOR TO W+/B
      @ 01,17 SAY " Clipper Window  - Interactive Demonstartion "
      @ 02,17 SAY "═════════════════════════════════════════════"
      @ 03,17 SAY " Enter Starting row      "  GET trow PICTURE "99" VALID(trow >= 0 .AND. trow < 23)
      @ 04,17 SAY " Enter Starting Column   "  GET tcol PICTURE "99" VALID(tcol >= 0 .AND. tcol < 77)
      @ 05,17 SAY " Enter Number of columns "  GET numcol PICTURE "99" VALID(numcol > 1)
      @ 06,17 SAY " Enter Number Of Rows    "  GET numrow PICTURE "99" VALID(numrow > 1)
      SET COLOR TO
   ELSE
      ***********************************************
      * Just in case the window wasn't initialized. *
      ***********************************************
      CLEAR
      @ 0,10 SAY "Clipper Window  - Interactive Demonstartion"
      @ 1,10 SAY "Enter Starting row      " GET trow PICTURE "99"
      @ 2,10 SAY "Enter Starting Column   " GET tcol PICTURE "99"
      @ 3,10 SAY "Enter Number of columns " GET numcol PICTURE "99"
      @ 4,10 SAY "Enter Number Of Rows    " GET numrow PICTURE "99"
   ENDIF
   READ
   CLEAR GETS
   ***************************************************
   * Get some text to show off the scrolling feature *
   ***************************************************
   @ 8,10 SAY "Please Enter some text to be printed in the window"
   SET DELIMITERS TO "[]"
   SET DELIMITERS ON
   SET INTENSITY OFF
   @ 9,0 GET text1
   IF numrow > 2
      @ 10,0 GET text2
   ENDIF
   IF numrow > 3
      @ 11,0 GET text3
   ENDIF
   IF numrow > 4
      @ 12,0 GET text4
   ENDIF
   IF numrow > 5
      @ 13,0 GET text5
   ENDIF
   IF numrow > 6
      @ 14,0 GET text6
   ENDIF
   READ

   *****************************
   * Ask a couple of questions *
   *****************************
   SET INTENSITY ON
   @ 8,0 CLEAR
   @ 8,10 SAY "Do You Want a (S)ingle Or (D)ouble Border <S/D>";
   GET bchar PICTURE "!" VALID(bchar $"SD")
   READ
   answer = " "
   @ 8,0 CLEAR
   @ 8,10 SAY "Do You Wish To Set The Window Colors (Y/N) ";
   GET answer PICTURE "!" VALID(answer $"YN")
   READ

   **********************
   * Process the answer *
   **********************
   IF answer = "Y"
      @  8,0 CLEAR
      @  8,5 SAY 'The window color set format is "background/foreground/Intensity/Blinking"'
      @  9,10 SAY "To set colors you use the following color codes."
      @ 10,10 SAY "          A        ==        BLACK"
      @ 11,10 SAY "          B        ==        BLUE"
      @ 12,10 SAY "          G        ==        GREEN"
      @ 13,10 SAY "          C        ==        CYAN"
      @ 14,10 SAY "          R        ==        RED"
      @ 15,10 SAY "          M        ==        MAGENTA"
      @ 16,10 SAY "          O        ==        BROWN"
      @ 17,10 SAY "          W        ==        WHITE"
      @ 18,10 SAY "          H        ==        HIGH INTENSITY"
      @ 19,10 SAY "          L        ==        BLINKING"
      @ 21,10 SAY "In order to set high intensity, put an H in the high intensity slot,"
      @ 22,10 SAY "put a L in the Blinking spot, otherwise leave them empty."
      @ 23,10 SAY 'EXAMPLE         "b/o/h/l"'
      @ 24,10 SAY "Enter the color code string for the border" ;
              GET bcolor PICTURE "!!!!!!!" VALID(LEN(bcolor) > 0)
      READ
      @ 24,0
      @ 24,10 SAY "Enter the color code string for the contents" ;
              GET ccolor PICTURE "!!!!!!!" VALID(LEN(ccolor) > 0)
      READ
   ENDIF

   ****************************************************
   * ready now to demonstrate the windowing functions *
   * initialize the user defined window               *
   ****************************************************
   wn1 = _sinit_wn(tcol, trow, numcol, numrow)

   ***********************************************
   * if wn1 = 0, window initialization failed    *
   * due to insufficient memory. Test it and see *
   ***********************************************
   IF wn1 = 0
      @ messrow,0 SAY "Not enough memory to execute window functions."
      EXIT
   ENDIF

   ****************************************************************
   * window initialization complete. Now set the border character *
   * Test bchar to find out what kind of border                   *
   ****************************************************************
   IF bchar = "D"
      IF .NOT. _sst_wnbc(wn1, double)
         @ messrow,0 SAY "Unable to set border character. Default of Space used."
      ENDIF
   ELSE
      IF .NOT. _sst_wnbc(wn1, single)
         @ messrow,0 SAY "Unable to set border character. Default of Space used."
      ENDIF
   ENDIF

   **************************************
   * Border character of some type set. *
   * Ready to set color if selected     *
   **************************************
   IF answer = "Y"
      _sst_wncl(wn1, bcolor, 'B')
      _sst_wncl(wn1, ccolor, 'C')

      *************************************
      * Clear the "Set Window Color" text *
      *************************************
      @ 8,0 CLEAR
   ENDIF

   *******************
   * Turn cursor off *
   *******************
   SET CURSOR OFF

   ******************************************
   * Ready to put the window on the screen. *
   ******************************************
   IF .NOT. _sdrw_wn(wn1)
      @ messrow, 0 SAY "Unable to draw window on screen"
      EXIT
   ENDIF

   ******************************************
   * window now on screen, so write the     *
   * text to the window, if it's available. *
   ******************************************
   IF LEN(TRIM(text1)) > 0
      _swte_txt(wn1, text1)
   ENDIF
   IF LEN(TRIM(text2)) > 0
      _swte_txt(wn1, text2)
   ENDIF
   IF LEN(TRIM(text3)) > 0
      _swte_txt(wn1, text3)
   ENDIF
   IF LEN(TRIM(text4)) > 0
      _swte_txt(wn1, text4)
   ENDIF
   IF LEN(TRIM(text5)) > 0
      _swte_txt(wn1, text5)
   ENDIF
   IF LEN(TRIM(text6)) > 0
      _swte_txt(wn1, text6)
   ENDIF

   ***********************************
   * Begin left scroll demonstration *
   ***********************************
   DO WHILE scroll > -10
      IF numrow + trow < 22
         @ numrow + trow + 2, 0 SAY "Press Any Key to See Scroll Left"
         INKEY(0)
      ELSE
         @ trow - 1, 0 SAY "Press Any Key to See Scroll Left"
         INKEY(0)
      ENDIF
      scroll = scroll - 1
      _scrl_vert(wn1,scroll)
      IF LEN(TRIM(text1)) > 0
         _swte_txt(wn1, text1)
      ENDIF
      IF LEN(TRIM(text2)) > 0
         _swte_txt(wn1, text2)
      ENDIF
      IF LEN(TRIM(text3)) > 0
         _swte_txt(wn1, text3)
      ENDIF
      IF LEN(TRIM(text4)) > 0
         _swte_txt(wn1, text4)
      ENDIF
      IF LEN(TRIM(text5)) > 0
         _swte_txt(wn1, text5)
      ENDIF
      IF LEN(TRIM(text6)) > 0
         _swte_txt(wn1, text6)
      ENDIF
   ENDDO

   ************************************
   * Begin right scroll demonstration *
   ************************************
   DO WHILE scroll < 0
      IF numrow + trow < 22
         @ numrow + trow + 2, 0 SAY "Press Any Key to See Scroll Right"
         INKEY(0)
      ELSE
         @ trow - 1, 0 SAY "Press Any Key to See Scroll Right"
         INKEY(0)
      ENDIF
      scroll = scroll + 1
      _scrl_vert(wn1,scroll)
      IF LEN(TRIM(text1)) > 0
         _swte_txt(wn1, text1)
      ENDIF
      IF LEN(TRIM(text2)) > 0
         _swte_txt(wn1, text2)
      ENDIF
      IF LEN(TRIM(text3)) > 0
         _swte_txt(wn1, text3)
      ENDIF
      IF LEN(TRIM(text4)) > 0
         _swte_txt(wn1, text4)
      ENDIF
      IF LEN(TRIM(text5)) > 0
         _swte_txt(wn1, text5)
      ENDIF
      IF LEN(TRIM(text6)) > 0
         _swte_txt(wn1, text6)
      ENDIF
   ENDDO

   IF numrow + trow < 22
      @ numrow + trow + 2, 0 SAY "Press Any Key to Scroll Up 1 Line."
      INKEY(0)
   ELSE
      @ trow - 1, 0 SAY "Press Any Key to Scroll Up 1 Line."
      INKEY(0)
   ENDIF
   _scrl_horz(wn1,1)
   IF numrow + trow < 22
      @ numrow + trow + 2, 0 SAY "Press Any Key to Scroll Down 1 Line."
      INKEY(0)
   ELSE
      @ trow - 1, 0 SAY "Press Any Key to Scroll Down 1 Line."
      INKEY(0)
   ENDIF
   _scrl_horz(wn1,-1)
   @ messrow, 0
   @ messrow, 0 SAY "Press any key to Continue"
   INKEY(0)
   _srem_wn(wn1)
   ******************
   * Turn cursor on *
   ******************
   SET CURSOR ON

   answer = " "
   @ messrow, 0 CLEAR
   @ messrow, 0 SAY "Do you wish to try again (Y/N) ";
   GET answer PICTURE "!" VALID (answer $"YN")
   READ
   IF answer = "N"
      EXIT
   ENDIF
ENDDO

*******************
* Turn cursor off *
*******************
SET CURSOR OFF

**********************************************************
* Don't need wn6 in it's current state, so get rid of it *
**********************************************************
_srem_wn(wn6)
CLEAR

****************************
* create a another window. *
****************************
wn2 = _sinit_wn(0, 18, 79, 5)

********************
* set window color *
********************
_sst_wncl(wn2, "a/r/h/", "C")
_sst_wncl(wn2, "a/r/h/", "B")

**************************************
* draw the window using all defaults *
**************************************
_sdrw_wn(wn2)

*************************************
* Write standard text on the screen *
*************************************
@ 02,20 SAY "Demonstration of Windowed Database"
@ 06,21 SAY "Its as easy as this"
@ 08,21 SAY "USE <database name>"
@ 09,21 SAY 'cur_record = _wn_dbf(wn,"Field" [,"Field" ,"Field"....])'
@ 10,02 SAY "A place to put                                      "
@ 11,02 SAY "the record #  ─────────┘          │     │      │        │        optional, up"
@ 12,02 SAY "Returned.                         │     │      │        └─────── to 10 fields"
@ 13,36 SAY "│     │      │                 allowed."
@ 14,14 SAY "Call the              │     │      │             The field names"
@ 15,14 SAY "function.  ───────────┘     │      └─────────────To write."
@ 16,42 SAY "│     The window"
@ 17,42 SAY "└──── to write in."

*********************************
* now write text in the window. *
*********************************
_swte_txt(wn2, SPACE(25) + "The following Keys are active")
_swte_txt(wn2, SPACE(10) + "<ESC> - Terminate Windowed Database, returning 0.")
_swte_txt(wn2, SPACE(10) + "<CR> - Terminate Windowed Database returning record number.")
_swte_txt(wn2, SPACE(10) + "Left Arrow - Scroll left.       Right Arrow - Scroll Right.")
_swte_txt(wn2, SPACE(10) + "Up Arrow - Scroll up.           Down Arrow - Scroll Down.")

********************************
* initialize wn6 for use again *
********************************
wn6 = _sinit_wn(0,3,28,1)

************************************************
* test to make sure the window was initialized *
************************************************
IF wn6 = 0
   @ messrow,0 SAY "Unable to create window wn6"
   WAIT
ELSE
   *******************************
   * set window border character *
   *******************************
   if .not. _sst_wnbc(wn6, single)
      @ messrow,0 SAY "Unable to set border character. Default of Space used."
   endif

   ****************************************************
   * draw the window on the screen and write the text *
   ****************************************************
   _sdrw_wn(wn6)
   _swte_txt(wn6, " Press Any Key To Proceed. ")

   ****************************************
   * do the following little number to be *
   * sure you have operators attention    *
   ****************************************
   wncol = 0
   wnrow = 3
   loppsw = .T.
   DO WHILE loopsw
      **********************************************
      *  this loop moves window from left to right *
      **********************************************
      FOR wncol = 0 TO 500
         **********************************************
         * move the window to new column, row coords. *
         **********************************************
         _smove_wn(wn6, wncol, wnrow)
         key = INKEY()
         IF key <> 0
            loopsw = .F.
            EXIT
         ENDIF
      NEXT
      IF .NOT. loopsw
         LOOP
      ENDIF
      *********************************************
      * this loop moves window from right to left *
      *********************************************
      FOR wncol = 500 TO 0 STEP -1
         **********************************************
         * move the window to new column, row coords. *
         **********************************************
         _smove_wn(wn6, wncol, wnrow)
         key = INKEY()
         IF key <> 0
            loopsw = .F.
            EXIT
         ENDIF
      NEXT
   ENDDO
ENDIF

**************
* remove wn6 *
**************
_srem_wn(wn6)

**********************************************
* create a new window. this will demonstrate *
* writing info using a database.             *
**********************************************
wn3 = _sinit_wn(5, 3, 70, 10)

***********************************************
* if wn3 = 0, window initialization failed    *
* due to insufficient memory. Test it and see *
***********************************************
IF wn3 = 0
   @ messrow,0 SAY "Not enough memory to execute window functions,"
   @ messrow + 1, 0 SAY "or invalid parameters were passed."
   RETURN
ENDIF

************************
* set border character *
************************
_sst_wnbc(wn3, single)

********************
* set window color *
********************
color = 'b/w/h/'
where = 'C'
IF TRIM(color) > " "
   _sst_wncl(wn3, color, where)
   _sst_wncl(wn3, color, "B")
ENDIF

******************************************
* Ready to put the window on the screen. *
******************************************
IF .NOT. _sdrw_wn(wn3)
   @ messrow, 0 SAY "Unable to draw window on screen"
   @ messrow + 1, 0 SAY "because invalid parameters were passed."
   RETURN
ENDIF

**********************
* open the database. *
**********************
USE customer

*******************************
* set pointer color prior to  *
* calling the wn_dbf function *
*******************************
_sst_ptcl(wn3, "c/o/h/")

***************************************
* now view the database in the window *
***************************************
currec = _wn_dbf(wn3, "custno", "comp_name", "comp_addr1", "comp_addr2", "comp_city", "comp_state", "comp_zip", "comp_phone")

*******************************************************
* open another window to show record number returned. *
*******************************************************
wn4 = _sinit_wn(20,10,40,10)
_sst_wnbc(wn4, double)
_sst_wncl(wn4, "b/c/h/", "C")
_sdrw_wn(wn4)
_swte_txt(wn4, " ")
_swte_txt(wn4, "Record pointer returned is " + STR(currec))
_swte_txt(wn4, "Press any key to continue")
INKEY(0)

**********************************
* remove the windows from memory *
**********************************
_srem_wn(wn4)
_srem_wn(wn3)
_srem_wn(wn2)

******************
* Turn cursor on *
******************
SET CURSOR ON

*******************************
* Demonstrate windowing using *
* Clippers  memo utilities.   *
* This is new to WDEMO.PRG    *
*******************************
CLEAR

*************************************
* write standard text to the screen *
* in a different way.               *
*************************************
TEXT

         This portion of the demo program will present techniques
       that can be used with Windows For Clipper, and a memo
       function provided with the compiler. The same techniques
       can also be applied to the dbedit function, although it
       may be difficult to determine where the dbedit function will
       place the information.

         In the following demonstration a window will be created, and
       help text that explains the cursor controls will be written to
       the window. Next the MEMOEDIT function will be called. The
       screen coordinates required by the MEMOEDIT function will be
       inside the window. At that point the MEMOEDIT function will
       take control until you terminate it. Once terminated, the
       window will be removed and this text should re-appear.


                       Press Any Key To Continue
ENDTEXT
************************
* wait for a key press *
************************

INKEY(0)

*****************************
* Create a window to cover  *
* the entire screen.        *
*****************************
wn1 = 0
wn1 = _sinit_wn(0,0,78,23)

*****************************************
* If we made it this far, no need to be *
* sure if the window will be created.   *
* So, set the border character.         *
*****************************************
_sst_wnbc(wn1, double)

*************************************
* now draw the window on the screen *
*************************************
_sdrw_wn(wn1)

********************************
* Write the help information   *
* to the window using Clipper. *
********************************
@ 01,32 SAY "Cursor Control"
@ 02,05 SAY ""+chr(24)+" or ^E  = Move up a line            HOME  = Beginning of current line"
@ 03,05 SAY ""+chr(25)+" or ^X  = Move down a line          END   = End of current line"
@ 04,05 SAY ""+chr(27)+" or ^S  = Move left a char.         ^HOME = Beginning of text"
@ 05,05 SAY ""+chr(26)+" or ^D  = Move right a char.        ^END  = End of text"
@ 06,05 SAY "^"+chr(27)+" or ^A = Move left a word          PgUp  = Jump to previous page"
@ 07,05 SAY "^"+chr(26)+" or ^F = Move right a word         PgDn  = Jump to next page"
@ 08,05 SAY "^PgUp    = Jump to top of screen     ^PgDn = Jump to bottom of screen"
@ 09,00 SAY "╠══════════════════════════════════════════════════════════════════════════════╣"
@ 10,29 SAY "Delete & Exit Control"
@ 11,12 SAY "^Y = Delete current line             ^B = Reformat text"
@ 12,12 SAY "^T = Delete word right               ESC = Exit no Save"
@ 13,30 SAY "^W = Exit with Save"
@ 14,00 SAY "╠══════════════════════════════════════════════════════════════════════════════╣"
* "══════════════════════════════════════════════════════════════════════════════"

***********************************************
* Okay, time to access the memoedit function. *
* The previous database is still in use.      *
* Position the record pointer to record 10.   *
* This is where the demo text is located in   *
* the memo file. One thing, if you decided to *
* to use this feature in this way, you need   *
* to be sure of is that the MEMOEDIT row,     *
* column coordinates do not exceed the        *
* boundaries of the window.                   *
***********************************************
GOTO(10)
REPLACE memo1 With MEMOEDIT(memo1, 15,1,23,78,.t.)

*******************************
* on return from the memoedit *
* function remove the window. *
*******************************
_srem_wn(wn1)

********************
* Closing remarks. *
********************
@ 16,0 CLEAR
@ 19,15 SAY "The Windows For Clipper Demo is now over."
@ 20,15 SAY "I hope you enjoyed this demo. For more "
@ 21,15 SAY "information on Windows For Clipper, read the "
@ 22,15 SAY "source file for this demo that is included."
@ 24,15 SAY "     Press Any Key To Continue"
INKEY(0)

RETURN